﻿<%
'----------------------------------------------------------
'页面功能：系统所有的方法、函数，本站核心文件。
'最后修改时间：2007-11-20  15:43
'作者：legal http://www.ilegal.cn
'备注：
'----------------------------------------------------------

'---------------------
'判断字符串长度
'---------------------
Function CheckStringLength(txt)
txt=trim(txt)
x = len(txt)
y = 0
for ii = 1 to x
  if asc(mid(txt,ii,1))<0 or asc(mid(txt,ii,1))>255 then
    y = y + 2
  else
    y = y + 1
  end if
next
CheckStringLength = y
End Function
'====================================================================
'判断字符串长度，lentype=1，判断是否为空
'====================================================================
Function CheckString(checkstr,strlen,lentype,errstr1,errstr2)
  if CheckStringLength(checkstr)>strlen then
    I1 errstr2&"|||||"
	i=1
  end if
  if lentype=1 and checkstr="" then
    I1 errstr1&"|||||"
	i=1
  end if
End Function

'====================================================================
'程序调式函数,输出变量并截断
'====================================================================
Function Debug(toWrite)
I1 toWrite
response.End()
End Function

'====================================================================
'检验是否为数字的函数，用户对页面传递的id的验证
'====================================================================
function CheckNum(checkstr)
  if not isnumeric(checkstr) or checkstr="" then
    call ShowAlert("参数错误","")
  end if
end function
'====================================================================
'网站状态检查，只在首页调用过
'采用appliction
'====================================================================
Function Check_Site_State()
if isempty(Application(CookieName & "_SiteEnable"))  then
	sql="select Sys_close,Sys_state from sysset"
	rs.open sql,conn,1,1
	if rs("Sys_state")=0 then
		  Application.Lock
		  Application(CookieName & "_SiteEnable") = 0
		  Application(CookieName & "_SiteDisbleWhy") = rs("Sys_close")
		  Application.UnLock
	else
		  Application.Lock
		  Application(CookieName & "_SiteEnable") = 1
		  Application(CookieName & "_SiteDisbleWhy") = ""
		  Application.UnLock
	end if
	rs.close
else
	if Application(CookieName & "_SiteEnable") = 0 then
	      Call ShowAlert(Application(CookieName & "_SiteDisbleWhy"),"")
	end if
end if
End Function

'====================================================================
'检验是否为数字的函数2,用户表单提交的验证
'====================================================================
Function CheckNu(checkstr,errstr)
  if not isnumeric(checkstr) or cstr(checkstr)="" then
    response.Write(errstr&"|||||")
	i=1
  end if
End Function
'====================================================================
'输出函数
'====================================================================
Function I1(I2)
response.Write(I2)
End Function
'====================================================================
'字符转换函数
'====================================================================
Function HTMLEncode(fString)
  If Not IsNull(fString) Then
	fString = replace(fString, ">", "&gt;")
	fString = replace(fString, "<", "&lt;")
	fString = Replace(fString,CHR(32)," ")		
	fString = Replace(fString,CHR(34),"&quot;")
	fString = Replace(fString,CHR(39),"&#39;")
	fString = Replace(fString,CHR(9),"&nbsp;")
	fString = Replace(fString,CHR(13),"")
	fString = Replace(fString,CHR(10)&CHR(10),"</P><P>")
	fString = Replace(fString,CHR(10),"<BR>")
	HTMLEncode = fString
  End If
End Function

'====================================================================
'字符转回函数
'====================================================================
function HTMLDncode(fString)
  If Not IsNull(fString) Then
    fString = Replace(fString, "&gt;",">" )
    fString = Replace(fString, "&lt;", "<")
    fString = Replace(fString, " ", CHR(32))
    fString = Replace(fString, "&nbsp;", CHR(9))
    fString = Replace(fString, "&quot;", CHR(34))
    fString = Replace(fString, "&#39;", CHR(39))
    fString = Replace(fString, "", CHR(13))
    fString = Replace(fString, "</P><P> ",CHR(10) & CHR(10) )
    fString = Replace(fString, "<BR> ",CHR(10) )
    HTMLDncode = fString
  End If
End Function 
'====================================================================
'截取前几个字符，intcpt=intercept是截取的文字个数，
'====================================================================
function Intcpt(iString,iNumber)
  if len(iString) > iNumber then
    Intcpt=left(iString,iNumber)
  else
    Intcpt=iString
  end if
end function
'------------------------
'ShowAlert(提示信息，转向地址)
function ShowAlert(AlertMess,url)
if url="" then
response.Write"<script>alert ('"&AlertMess&"');location.href='javascript:history.go(-1)';</script> "
response.End()
else
response.Write"<script>alert ('"&AlertMess&"');location.href='"&url&"';</script> "
response.End()
end if
end function
'------------------------
'检验
function SwitchBoolean(I1)
if I1=1 then 
response.Write("<img src='Images/on.gif'>")
else
response.Write("<img src='Images/off.gif'>")
end if
end function
'------------------------
'输出日期
function getDate(l1)
response.Write(year(l1)&"-"&month(l1)&"-"&day(l1))
end function
'------------------------
' 转换Radio的是否/开关状态
function switchRadio(l1,l2,l3)
if l3="1" then 
select case l1
  case "0"
  response.Write("是<input name="""&l2&""" type=""radio"" value=""1"">")
  response.Write("否<input name="""&l2&""" type=""radio"" value=""2"">")
  case "1"
  response.Write("是<input name="""&l2&""" type=""radio"" value=""1"" checked=""checked"">")
  response.Write("否<input name="""&l2&""" type=""radio"" value=""2"">")
  case "2"
  response.Write("是<input name="""&l2&""" type=""radio"" value=""1"">")
  response.Write("否<input name="""&l2&""" type=""radio"" value=""2"" checked=""checked"">")
end select 

else if l3="2" then 
select case l1
  case "0"
  response.Write("开<input name="""&l2&""" type=""radio"" value=""1"">")
  response.Write("关<input name="""&l2&""" type=""radio"" value=""2"">")
  case "1"
  response.Write("开<input name="""&l2&""" type=""radio"" value=""1"" checked=""checked"">")
  response.Write("关<input name="""&l2&""" type=""radio"" value=""2"">")
  case "2"
  response.Write("开<input name="""&l2&""" type=""radio"" value=""1"">")
  response.Write("关<input name="""&l2&""" type=""radio"" value=""2"" checked=""checked"">")
end select 
end if 
end if
end function

'====================================================================
'转换checkbox，参数：是否，name
'====================================================================
Function SwitchCheckbox(I2,I3)
	if I2=1 then
		I1 "<input name="""&I3&""" type=""checkbox"" value=""1"" checked=""checked"">"
	else
		I1 "<input name="""&I3&""" type=""checkbox"" value=""1"">"
	end if
End Function
'将IP转化成为十进制数
function cIp(sip)
    dim tip
    tip = split(sip,".")
	if cint(tip(0))<128 then
		cIp=cint(tip(0))*256*256*256+cint(tip(1))*256*256+cint(tip(2))*256+cint(tip(3))
	else
		cIp=cint(tip(0))*256*256*256+cint(tip(1))*256*256+cint(tip(2))*256+cint(tip(3))-4294967296
	end if
end function
'在左边加0
function addZero(I1,I2)
addZero=cstr(I1)
if len(I1)<I2 then'如果被加字段已经不符合要求
  for j=1 to I2-len(I1)
    addZero="0"&addZero
  next
end if
end function
'产生数组字符函数:长度，分隔内容，分隔符号；如：2，null，&；则：null&null
function creatString(I1,I2,I3)
for i=0 to I1
if creatString="" then
creatString=I2
else
creatString=creatString&I3&I2
end if
next
end function


'====================================================================
'数据库备份恢复，文件管理
'
'====================================================================
function bc(t,s)
 dim tl,sl,i
 bc=0
 sl=len(s)
 tl=len(t)
 if tl< sl then bc=1:exit function
 for i=1 to sl
  if mid(t,i,1)<>mid(s,i,1) then bc=1:exit function
 next
end function
'====================================================================
'数据库备份恢复，文件管理
'复制文件
'====================================================================
Function CopyFiles(TempSource,TempEnd) 
    Dim CopyFSO
    Set CopyFSO = Server.CreateObject("Scripting.FileSystemObject")
	IF CopyFSO.FileExists(TempEnd) then
       CopyFiles="目标备份文件 <b>" & TempEnd & "</b> 已存在，请先删除!"
       Set CopyFSO=Nothing
       Exit Function
    End If
    IF CopyFSO.FileExists(TempSource) Then
    Else
       CopyFiles="要复制的源数据库文件 <b>"&TempSource&"</b> 不存在!"
       Set CopyFSO=Nothing
       Exit Function
    End If
    CopyFSO.CopyFile TempSource,TempEnd
    CopyFiles="已经成功复制文件 <b>"&TempSource&"</b> 到 <b>"&TempEnd&"</b>"
    Set CopyFSO = Nothing
End Function
Function DeleteFiles(FilePath) '删除文件
	On Error Resume Next
    Dim FSO
    Set FSO=Server.CreateObject("Scripting.FileSystemObject")
    IF FSO.FileExists(FilePath) Then
		FSO.DeleteFile FilePath,True
		if err then
			Set FSO = Nothing
			DeleteFiles = 0
			err.clear
			exit function
		end if
		DeleteFiles = True
    Else
		DeleteFiles = 0
    End IF
    Set FSO = Nothing
End Function
'====================================================================
'数据库备份恢复，文件管理
'计算随机数
'====================================================================
function randomStr(intLength)
    dim strSeed,seedLength,pos,str,i
    strSeed = "abcdefghijklmnopqrstuvwxyz1234567890"
    seedLength=len(strSeed)
    str=""
    Randomize
    for i=1 to intLength
     str=str+mid(strSeed,int(seedLength*rnd)+1,1)
    next
    randomStr=str
end function
'====================================================================
'数据库备份恢复，文件管理
'日期转换函数
'====================================================================
Function DateToStr(DateTime,ShowType)  
	Dim DateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecond
	Dim FullWeekday,shortWeekday,Fullmonth,Shortmonth,TimeZone1,TimeZone2
	TimeZone1="+0800"
	TimeZone2="+08:00"
	FullWeekday=Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
	shortWeekday=Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat")
    Fullmonth=Array("January","February","March","April","May","June","July","August","September","October","November","December")
    Shortmonth=Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")

	DateMonth=Month(DateTime)
	DateDay=Day(DateTime)
	DateHour=Hour(DateTime)
	DateMinute=Minute(DateTime)
	DateWeek=weekday(DateTime)
	DateSecond=Second(DateTime)
	If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
	If Len(DateDay)<2 Then DateDay="0"&DateDay
	If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
	Select Case ShowType
	Case "Y-m-d"  
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
	Case "Y-m-d H:I A"
		Dim DateAMPM
		If DateHour>12 Then 
			DateHour=DateHour-12
			DateAMPM="PM"
		Else
			DateHour=DateHour
			DateAMPM="AM"
		End If
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
	Case "Y-m-d H:I:S"
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
	Case "YmdHIS"
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond	
	Case "ym"
		DateToStr=Right(Year(DateTime),2)&DateMonth
	Case "d"
		DateToStr=DateDay
    Case "ymd"
        DateToStr=Right(Year(DateTime),4)&DateMonth&DateDay
    Case "mdy" 
        Dim DayEnd
        select Case DateDay
         Case 1 
          DayEnd="st"
         Case 2
          DayEnd="nd"
         Case 3
          DayEnd="rd"
         Case Else
          DayEnd="th"
        End Select 
        DateToStr=Fullmonth(DateMonth-1)&" "&DateDay&DayEnd&" "&Right(Year(DateTime),4)
    Case "w,d m y H:I:S" 
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
        DateToStr=shortWeekday(DateWeek-1)&","&DateDay&" "& Left(Fullmonth(DateMonth-1),3) &" "&Right(Year(DateTime),4)&" "&DateHour&":"&DateMinute&":"&DateSecond&" "&TimeZone1
    Case "y-m-dTH:I:S"
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"T"&DateHour&":"&DateMinute&":"&DateSecond&TimeZone2
	Case Else
		If Len(DateHour)<2 Then DateHour="0"&DateHour
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
	End Select
End Function
'====================================================================
'数据库备份恢复，文件管理
'释放网站缓存
'====================================================================
Function FreeApplicationMemory
    on error resume next
	Response.Write "释放网站缓存数据列表：<div style='padding:5px 5px 5px 10px;'>"
	Dim Thing
	For Each Thing IN Application.Contents
		IF Left(Thing,Len(CookieName)) = CookieName Then
			Response.Write "<span style='color:#666'>" & thing & "</span><br/>"
			IF isObject(Application.Contents(Thing)) Then
				Application.Contents(Thing).Close
				Set Application.Contents(Thing) = Nothing
				Application.Contents(Thing) = Null
			ElseIF isArray(Application.Contents(Thing)) Then
				Set Application.Contents(Thing) = Nothing
				Application.Contents(Thing) = Null
			Else
				Application.Contents(Thing) = Null
			End IF
		End IF
	Next
	response.write "</div>"
End Function
'====================================================================
'数据库备份恢复，文件管理
'删除文件
'====================================================================
   if Request.form("whatdo")="DelFiles" then
    dim getFolders,getFiles,getFolder,getFile,getFolderCount,getFileCount
    Dim FSODel
    Set FSODel=Server.CreateObject("Scripting.FileSystemObject")
    getFolders=split(Request.form("folders"),", ")
    getFiles=split(Request.form("Files"),", ")
    getFolderCount=0
    getFileCount=0
    for each getFolder in getFolders
     if len(getPathList(getFolder)(1))>0 then
       session(CookieName&"_ShowMsg")=1
       session(CookieName&"_MsgText")="<span style=""color:#900"">“"&getFolder&"”</span> 文件夹内含有文件，无法删除!"
       Response.Redirect("mdb_files.asp?Smenu=Attachments")
     end if
     if FSODel.FolderExists(Server.MapPath(getFolder)) then
      FSODel.DeleteFolder Server.MapPath(getFolder),true
      getFolderCount=getFolderCount+1
     end if
    next
    for each getFile in getFiles
     if FSODel.FileExists(Server.MapPath(getFile)) then
      FSODel.DeleteFile Server.MapPath(getFile),true
      getFileCount=getFileCount+1
     end if
    next
    session(CookieName&"_ShowMsg")=1
    session(CookieName&"_MsgText")="有 <span style=""color:#900"">"&getFileCount&" 文件, "&getFolderCount&" 个文件夹</span> 被删除!"
	Call ShowAlert("删除成功~！","")
   end if
'====================================================================
'数据库备份恢复，文件管理
'获取文件图标
'====================================================================
Function getFileIcons(str) 
 dim FileIcon,Target
 Select Case str
  case ".jpg"
   FileIcon="jpg.gif"
  case ".gif"
   FileIcon="gif.gif"
  case ".bmp"
   FileIcon="bmp.gif"
  case ".png"
   FileIcon="png.gif"
 case ".zip"
   FileIcon="zip.gif"  
 case ".rar"
   FileIcon="rar.gif"  
 case ".swf"
   FileIcon="swf.gif"  
 case ".mdb"
   FileIcon="mdb.gif"  
 case ".doc"
   FileIcon="doc.gif"  
 case ".xls"
   FileIcon="xls.gif"  
 case ".pdf"
   FileIcon="pdf.gif"  
 case ".mbk"
   FileIcon="mbk.gif"
 case ".mp3"
   FileIcon="mp3.gif"
 case ".wmv"
   FileIcon="wma.gif"
 case ".wma"
   FileIcon="wma.gif"
 case else
   FileIcon="unknow.gif"
 end Select
 getFileIcons="<img border=""0"" src=""Images/file_icon/"&FileIcon&""" style=""margin:4px 3px -3px 0px""/>"
End Function
'====================================================================
'数据库备份恢复，文件管理
'获得路径的文件信息
'====================================================================
function getPathList(pathName)
 dim FSO,ServerFolder,getInfo,getInfos,tempS
 getInfo=""
		Set FSO=Server.CreateObject("Scripting.FileSystemObject")
		
		Set ServerFolder=FSO.GetFolder(Server.MapPath(pathName))
			Dim ServerFolderList,ServerFolderEvery
			Set ServerFolderList=ServerFolder.SubFolders
			tempS=""
			For Each ServerFolderEvery IN ServerFolderList
                getInfo=getInfo&tempS&ServerFolderEvery.Name
                tempS="*"
			Next
            getInfo=getInfo&"|"
			Dim ServerFileList,ServerFileEvery
			Set ServerFileList=ServerFolder.Files
			tempS=""
			For Each ServerFileEvery IN ServerFileList
                getInfo=getInfo&tempS&ServerFileEvery.Name
                tempS="*"
			Next
	Set FSO=Nothing
	getInfos=split(getInfo,"|")
	getPathList=getInfos
end function
'====================================================================
'数据库备份恢复，文件管理
'获取文件信息
'====================================================================
function getFileInfo(FileName)
 dim FSO,File,FileInfo(3)
 Set FSO=Server.CreateObject("Scripting.FileSystemObject")
 if FSO.FileExists(Server.MapPath(FileName)) then
   Set File=FSO.GetFile(Server.MapPath(FileName))
   FileInfo(0)=File.Size
   if FileInfo(0)/1000>1 then 
     FileInfo(0)=int(FileInfo(0)/1000)&" KB"
    else
     FileInfo(0)=FileInfo(0)&" Bytes"
   end if
   FileInfo(1)=lcase(right(FileName,4))
   FileInfo(2)=File.DateCreated
   FileInfo(3)=File.Type 
 end if
   getFileInfo=FileInfo
 Set FSO=Nothing
end function
'====================================================================
'根据类别的ID得到名字
'
'====================================================================
Function Get_Template_Column_Name(ID)   
Select Case ID
    Case "1" Get_Template_Column_Name="首页模板"
    Case "2" Get_Template_Column_Name="问卷列表模板"
    Case "3" Get_Template_Column_Name="问卷显示模板"
    Case "4" Get_Template_Column_Name="私有问卷页模板"
    Case "5" Get_Template_Column_Name="留言模板"
    Case "6" Get_Template_Column_Name="友情链接模板"
    Case "7" Get_Template_Column_Name="功能模板"
    Case "8" Get_Template_Column_Name="模板标签"
    Case "9" Get_Template_Column_Name="问卷后台预览模板"
End Select
End Function
'====================================================================
'结束组件函数
'
'====================================================================
Function pagend()
  set rs=nothing
  conn.close
  set conn=nothing
End Function
'====================================================================
'分页函数
'参数：目标页，单位，
'====================================================================
Function pageBox(page,unit,item_count,page_now,total)
  pageBox=pageBox&"当前第"&page_now&"页"
  pageBox=pageBox& "&nbsp;&nbsp;共"&item_count&""&unit&""
  if cint(page_now)=1 then
  pageBox=pageBox& "&nbsp;&nbsp;首页"
  else
  pageBox=pageBox& "&nbsp;&nbsp;<a href="""&page&"page=1"">首页</a>"
  end if
  if cint(page_now)>1 and cint(total)>1 then
  pageBox=pageBox& "&nbsp;&nbsp;<a href="""&page&"page="&page_now-1&""">上一页</a>"
  else
  pageBox=pageBox& "&nbsp;&nbsp;上一页"
  end if			
  if cint(page_now)<cint(total) then
  pageBox=pageBox& "&nbsp;&nbsp;<a href="""&page&"page="&page_now+1&""">下一页</a>"
  else
  pageBox=pageBox& "&nbsp;&nbsp;下一页"
  end if			
  if cint(page_now)<>cint(total) then
  pageBox=pageBox& "&nbsp;&nbsp;<a href="""&page&"page="&total&""">尾页</a>"
  else
  pageBox=pageBox& "&nbsp;&nbsp;尾页"
  end if
  pageBox=pageBox& "&nbsp;&nbsp;共"&total&"页"  
End Function

%>
